home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_2 / sorce.scr < prev    next >
Internet Message Format  |  1991-05-13  |  15KB
  1. From ervin@pinbot.enet.dec.com Fri May 10 15:35:00 1991
  2. Flags: 000000000001
  3. Received: from enet-gw.pa.dec.com by hpuxa.acs.ohio-state.edu with SMTP
  4.     (15.11/15.6) id AA08264; Fri, 10 May 91 13:34:42 edt
  5. Return-Path: <ervin@pinbot.enet.dec.com>
  6. Received: by enet-gw.pa.dec.com; id AA14061; Fri, 10 May 91 10:34:10 -0700
  7. Message-Id: <9105101734.AA14061@enet-gw.pa.dec.com>
  8. Received: from pinbot.enet; by decwrl.enet; Fri, 10 May 91 10:34:21 PDT
  9. Date: Fri, 10 May 91 10:34:21 PDT
  10. From: 10-May-1991 1331 <ervin@pinbot.enet.dec.com>
  11. To: ryee@hpuxa.acs.ohio-state.edu
  12. Subject: Re: HP48: Waynes mail server 
  13.  
  14. Hi Roger,
  15.  
  16. Here's another file that would be good for Wayne's mail server.  This is the
  17. source code to my screen dissolver.  The executable is currently in the
  18. graphics directory, so that's probably where this file should go as well.
  19.  
  20. How about a file description like "Source code for Joe Ervin's dissolver.".
  21.  
  22. Thanks again!
  23.  
  24. >>>Joe
  25.  
  26. ****************************************************************************
  27. ; DISSOLVE VERSION 0.2
  28. ; Joe Ervin - 4-MAR-1991
  29. ;
  30. ; The following program is written for the HP-48SX.  This program is intended
  31. ; to be assembled using the Star assembler, version 1.04.2 or later.
  32.  
  33. ; The purpose of this program is to provide a function which can be used to do
  34. ; screen dissolves.  In other words, this program will take a GROB from the
  35. ; stack and dissolve it into PICT, updating PICT with the pixels of the new
  36. ; GROB one pixel at a time, in a visually random sequence so that the visual 
  37. ; effect is that the image contained in the GROB dissolves into the display,
  38. ; replacing the existing image in PICT in an asthetically pleasing manner.
  39.  
  40.  
  41.  
  42. ; THEORY:
  43. ;
  44. ; The basic technique used to dissolve the screen will be to number the nibbles
  45. ; which make up the GROB sequentially, such that the nibbles which make up the
  46. ; first row of pixels start from the left with 1, 2, 3, and so on.  the rest 
  47. ; of the lines are numbered similarly.  In this way, all the nibbles that make
  48. ; up the GROB (and PICT) are numbered from 1 to n, where n is the last nibble 
  49. ; on the right end of the last row of pixels.
  50. ; 
  51. ; The method used to generate the pixel addresses will be to use a simple 
  52. ; psuedo-random number generator formula.  There are many such formulae which 
  53. ; will generate all integers between 0 and 2^n exactly once (which is what
  54. ; we want here.  The formula I have chosen is a particularly simple one, and
  55. ; is given as : 
  56. ;
  57. ; next(r) = (r * 5) + 3.
  58. ;
  59. ; In our case, we will mask these random numbers to 14-bits.  We will use the
  60. ; bottom 2 bits of this random number to indicate which of the four pixels
  61. ; within each nibble we should transfer.  This allows us
  62. ; to randomly generate relative addresses for all the pixels in PICT (assuming
  63. ; that PICT is 131x64, as is usually the case). 
  64. ; Using this, we can successfully generate the address of every pixel in 
  65. ; PICT exactly once.  Of course, we will unavoidably generate addresses which 
  66. ; are outside the bounds of PICT (since the size of PICT is not an even power
  67. ; of 2).  Such addresses will simply be discarded. 
  68.  
  69. ; NOTES:    D0 is the RPL instruction pointer.
  70. ;             D1 is the stack pointer. Grows towards lower addresses.
  71. ;             B is the FRAME pointer. Grows towards higher addresses.
  72. ;             D is the amount of nibbles between stack and heap.
  73.  
  74. ; Each of the above registers may have a secondary use within the program.
  75.  
  76. ;            R0 holds the pointer to the dest GROB (PICT) data field.   
  77. ;         R1 holds the GROB size.
  78. ;        R2 holds a pointer to the source GROB data field.
  79. ;        R3 holds the 12 bit version of the random number.
  80. ;               R4 holds the 14/12 bit version of the random number.
  81. ;        D  holds the 14-bit mask.
  82. ;        B  holds the bit mask corresponding to the bit within the
  83. ;           nibble which is to be transfered.
  84.  
  85.     header            ; puts the kermit header at the top.
  86.  
  87.  
  88. ; Below is the internal RPL structure which will do error checking and which
  89. ; encapsulates the machine language routine.
  90. ; 
  91. ; The RPL code expects the following parameters on the stack from the user.
  92. ; 
  93. ; 2: A real number.  Zero indicates that a bit-wise dissolve should be 
  94. ;    performed.  A 1 indicates that tiling should be done.
  95. ; 1: Source GROB.
  96.  
  97.  
  98. ; The purpose of this RPL code is to do the argument
  99. ; type checking and build the proper parameters on the stack for the machine
  100. ; language code which does the actual screen dissolve.
  101.  
  102.  
  103.     badgrob = `Invalid GROB Data'
  104.     badgrobs = $((2 * sz^badgrob) + 5)    
  105.     badpict = `Invalid PICT Size'
  106.     badpicts = $((2 * sz^badpict) + 5)    
  107.  
  108.     radix    ^x10    ; Set the radix to hex.
  109.  
  110.     rpl        ; Start of RPL body.
  111.     2d9d        ; Start of program
  112.     1884d        ; Set last token to <0h>. 
  113.     18a8d        ; Check that there are at least 2 arguments on the stk.
  114.     18fb2        ; Check that the args are the right type.
  115.     4107        ; <1Ch>    2: real, 1: GROB.
  116.       2d9d        ; Start of program
  117.       3188        ; Internal DUP.
  118.  
  119. ; Now we need to check the size of the GROB to make sure it has the standard 
  120. ; size.
  121.       1ca62        ; Internal SIZE (graphic).
  122.       5a03        ; binary --> short
  123.       3223        ; Internal SWAP.
  124.       5a03        ; binary --> short
  125.       3223        ; Internal SWAP.
  126.             ; Now both dimensions of the grob are short binaries.
  127.       2911        ; System Binary
  128.       40        ; 64 decimal.
  129.       63d3a        ; If TOS-1 = TOS (Syst Bin), then skip next, else
  130.             ; do next and return.
  131.       2d9d        ; Start of program
  132.         3244    ; Internal DROP. Get rid of row dimension.
  133.         2A2C    ; String
  134.         _data.a badgrobs     ; length of the string.
  135.         _ascii badgrob
  136.         1a339        ; DOERR.
  137.         312b        ; end marker
  138.       2911        ; System Binary
  139.       83        ; 131 decimal.
  140.       63d3a        ; If TOS-1 = TOS (Syst Bin), then skip next, else
  141.             ; do next and return.
  142.       2d9d        ; Start of program
  143.         3244        ; Internal DROP. Get rid of row dimension.
  144.         2A2C        ; String
  145.         _data.a badgrobs     ; length of the string.
  146.         _ascii badgrob
  147.         1a339        ; DOERR.
  148.       312b        ; end marker
  149.  
  150. ; Now we need to check the size of PICT to make sure it has the standard size.
  151.       5187f        ; Get pict dimensions.
  152.       3223        ; Internal SWAP --> 2: columns, 1: rows.
  153.       2911        ; System Binary
  154.       40        ; 64 decimal.
  155.       63d3a        ; If TOS-1 = TOS (Syst Bin), then skip next, else
  156.             ; do next and return.
  157.       2d9d        ; Start of program
  158.         3244        ; Internal DROP. Get rid of row dimension.
  159.         2A2C        ; String
  160.         _data.a badpicts     ; length of the string.
  161.         _ascii badpict
  162.         1a339        ; DOERR.
  163.       312b        ; end marker
  164.       2911        ; System Binary
  165.       83        ; 131 decimal.
  166.       63d3a        ; If TOS-1 = TOS (Syst Bin), then skip next, else
  167.             ; do next and return.
  168.       2d9d        ; Start of program
  169.         3244        ; Internal DROP. Get rid of row dimension.
  170.         2A2C        ; String
  171.         _data.a badpicts     ; length of the string.
  172.         _ascii badpict
  173.         1a339        ; DOERR.
  174.       312b        ; end marker
  175.       3223        ; Internal SWAP. Put the "real" at level 1.
  176.       18cea        ; Convert real to system binary.
  177.       2911        ; System Binary; the size-1 of PICT in nibbles.
  178.       ^d2175        ; 2175 decimal. 
  179.       3223        ; Internal SWAP.
  180.     endrpl
  181.  
  182. ;*************************************************************************
  183. ; The machine language portion of DISS starts here.
  184.  
  185.  
  186.         radix ^d10    ; set default radix to decimal
  187.  
  188.     code        ; START OF MACHINE LANGUAGE ROUTINE.
  189.  
  190.  
  191. ; Addresses of ROM routines.
  192.  
  193.     save_registers    =    ^x679B    ; Saves system registers.    
  194.     restore_registers =     ^x67d2  ; Restores system register.
  195.     rplcont        =     ^x71BE  ; Jumps to the next RPL instruction.
  196.     rr_rplcont    =    ^x5143  ; Restores the system registers and
  197.                     ; then does rplcont.
  198.     get_short    =     ^x6641    ; Pops the short of TOS and returns it
  199.                     ; into A.A
  200.  
  201.  
  202. ; General address definitions
  203.     bos        =     ^x7057E    ; Pointer to beginning of the stack.
  204.     pict_pointer    =    ^x70565    ; Pointer to PICT grob.
  205.  
  206.  
  207. START:    
  208.  
  209.  
  210.  
  211.  
  212. ; The first thing we need to do is to get the input parameters off the stack.
  213. ; The parameters that this routine expects on the stack are:
  214.   
  215. ; 3:  Source GROB (the one which will be on display at end of routine.)
  216. ; 2:  System binary integer (short) indicating the number of nibbles to move.
  217. ; 1:  System binary integer (short) indicating #0 for bit-wise dissolve, or 
  218. ;     #(nonzero) for tiling.
  219.  
  220.  
  221.     CALL.A get_short    ; Put the tile/dissolve indicator in A.A
  222.             ; If this integer is a zero, then we
  223.             ; do bit-wise dissolve.  If non-zero, we do nibble
  224.             ; tiling.
  225.     CLR.W    D    ; Clear every bit in D.
  226.     BRZ.A    A, DISSOLVE    ; If zero, then leave D.S clear for (dissolve).
  227.                 ; Otherwise, set D.S = 1 (for tiling).
  228. TILING:    INC.S    D    ; Set D.S to 1 (nonzero is all that matters).
  229.             ; This field will be tested later.
  230. DISSOLVE:    
  231.     CALL.A get_short    ; Get the level 2 system binary off the stack into A.A.
  232.             ; This is the GROB size-1.
  233.     CLR.W    C    ;
  234.     SWAP.A    A, C    ; 
  235.     MOVE.W    C, R1    ; Save it in R1.
  236.  
  237.  
  238. ; Then we get the pointer to the source GROB data and load it into R2.
  239.  
  240.     MOVE.A     @D1, A    ; Gets the address of the level 3 object.
  241.     ADD.A    10, A    ; Skip over the prolog and size fields.
  242.     ADD.A    10, A    ; Skip over the row and column fields of the GROB.
  243.     MOVE.A    A, R2    ; Save pointer to GROB data in R2.
  244.  
  245.     ADD.A    5, D1    ; to pop the level 3 object off the stack...
  246.     INC.A    D    ; and increment the free size counter.
  247.  
  248.  
  249.  
  250.  
  251.     CALL.A    save_registers    ; Save the system registers.
  252.  
  253. ; At this point, we have saved all the information we need to start the loop
  254. ; which calculates all the screen addresses randomly. 
  255.  
  256.  
  257. ; The following psuedocode represents essentially what this code does:
  258.  
  259.  
  260. ; BEGIN
  261. ;   R = 0
  262. ;   TRANSFER_PIXEL(R[BITMASK]);
  263. ;   DO
  264. ;     R = RANDOM(R)
  265. ;     IF R <= GROB_SIZE THEN TRANSFER_PIXEL(R[BITMASK])
  266. ;   UNTIL R = 0
  267. ; END;
  268.  
  269.  
  270.  
  271. ; We need to fetch the address of the beginning of the data field of PICT.
  272.  
  273.     MOVE.A     pict_pointer, D1    ; Address which contains pointer to 
  274.                     ; display.
  275.     MOVE.A    @D1, C    ; get the address of PICT GROB.
  276.     ADD.A    10, C    ; Skip over the prolog and size fields.
  277.     ADD.A    10, C    ; Skip over the row and column size fields.
  278.     MOVE.A    C, R0    ; Copy pointer to PICT data field in R0 for later use.
  279.  
  280. ; We need to initialize the mask held in D to ^x3FFF if doing a bit-wise 
  281. ; dissolve or to ^xFFF if tiling.
  282.  
  283.     CLR.W    C    ; 
  284.     MOVE.P5    ^x3FFF, C    ; Puts 14 ones in the lower bit positions of C,
  285.     BRZ.S    D, DISSOLVE2    ; Tiling or bit-wise dissolve?
  286.     MOVE.P5 ^xFFF, C    ; Change the mask to 12 bits for tiling.
  287. DISSOLVE2:    MOVE.A    C, D    ; and transfer it to D.
  288.  
  289.  
  290.     CLR.W    A    ;
  291.     MOVE.W    A, R3    ; Initialize the random value to 0.
  292.     MOVE.W    A, R4    ; Note: because of the really cool properties of the
  293.             ; algorithm used here, the value 0 will not repeat 
  294.             ; until every other integer has been created.  
  295.             ; Note that if doing tiling we use a 12-bit integer,
  296.             ; and if dissolving, we use a 14-bit integer.
  297.     
  298.     CLR.W    C
  299.     MOVE.P2 ^x11, C    ; Indicates the first bit for dissolve.
  300.     BRZ.S    D, DISSOLVE3    ; Tiling or bit-wise dissolve?
  301.     MOVE.P2 ^x0F, C    ; Change the bit pattern to ^xF if tiling.
  302. DISSOLVE3:    MOVE.B    C, B    
  303.  
  304. ; The bottom nibble of B holds the bit mask which indicates which 
  305. ; bit(s) in the nibble we are transfering.  If we are dissolving, then only 
  306. ; 1 bit of this nibble is set.  If tiling, then this nibble contains ^xF to 
  307. ; indicate that all four bits within the nibble should be transfered at once.
  308.  
  309. ; Now we must transfer a pixel of data at the
  310. ; Rth nibble of the stack GROB to the PICT GROB.  The bit within the nibble
  311. ; that will be transfered is indicated by the BITMASK variable.
  312.  
  313.     MOVE.A    R3, A    ; Get the random number.
  314.     CALL    TRANSFER_GROB    ; Transfer the GROB data pointed to by A.A.
  315.  
  316.     
  317. DO:    ; Begin the loop.
  318.  
  319.     MOVE.W    R4, C    ; Get the 14/12-bit version of the random number R. 
  320.     ADD.A    C, C    ; 
  321.     ADD.A    C, C    ;
  322.     MOVE.W    R4, A    ;
  323.     ADD.A    A, C    ; Multiply R by 5,...
  324.     ADD.A    3, C    ; ....and add 3.
  325.     AND.A    D, C    ; Mask off everything but the lower 14/12-bits.
  326.     MOVE.A    C, R4    ; Temporary storage for 14/12-bit version.  This
  327.             ; 14/12 bit number is compared to 0 to see if the 
  328.             ; random number generator has finished its cycle.
  329.     MOVE.A    C, R3    ; This is for the case of tiling.  If dissolving, this
  330.             ; will be overwritten below.
  331.     BRNZ.S    D, P_TRANS    ; Tiling or dissolving? If tiling, then we can
  332.                 ; leave B containing ^xF.
  333.     SRB.A    C
  334.     SRB.A    C       ; Shift the bottom two bits out, yielding a 12-bit #.
  335.     MOVE.A    C, R3    ; Save the 12-bit random number in R3. This copy of 
  336.             ; the random number R is always 12-bits, and is used
  337.             ; by the code which transfers the GROB data to index
  338.             ; into the GROB.
  339.     SRB.B    B    ; Shift the mask one bit to the right to point to the
  340.             ; next bit to be tranfered.  This works because the
  341.             ; the random number generator used here cycles the 
  342.             ; botom 2 bits through 3, 2, 1, 0, 3, 2, 1, 0, etc.
  343.             ; Therefore, we just drop them and rotate the bit mask.
  344.     MOVE.B    B, A    ; Get copy of bit mask.
  345.     BRBC    3, A, P_TRANS    ; If bit mask is OK, skip to P_TRANS.
  346.     SETB    7, A    ; Else, insert a 1 in bit 7 to keep the rotating bit 
  347.             ; mask working properly.
  348.     MOVE.B    A, B    ; Restore new bit mask.
  349.  
  350. P_TRANS:
  351.  
  352.     MOVE.A  R1, A    ; Get the GROB size.
  353.     MOVE.A    R3, C    ; Get the 12-bit version of the random number. This 
  354.             ; will be used below as an index into the source GROB.
  355.     BRGT.A    C, A, SKIP    ; IF R is greater than the GROB size, then 
  356.                 ; skip it.
  357.         
  358.     SWAP.A A, C    ; Put the GROB offset in A.A. Required by the procedure
  359.             ; TRANSFER_GROB.
  360.     CALL    TRANSFER_GROB    ; Transfer a pixel or nibble of data from the
  361.                 ; source GROB to PICT.
  362.  
  363.  
  364. SKIP:    ; We came here because the generated random number was outside the 
  365.     ; range of addresses in the GROB.
  366.  
  367.     MOVE.A    R4, A    ; Get the value of R most recently generated.
  368.         BRNZ.A    A, DO    ; If the last value of R is zero, then we have finished
  369.             ; generating all the addresses, and have finished this
  370.             ; pass. Otherwise, we must branch up and keep
  371.             ; generating more random values.
  372.  
  373.  
  374. ; Now to restore things to a sane state before returning control to the calling
  375. ; RPL program.
  376.  
  377.  
  378.  
  379. DONE:   JUMP rr_rplcont ; Restore the system registers...
  380.             ; and continue on with the RPL thread.
  381.  
  382. TRANSFER_GROB:            ; Routine that transfers GROB data from the source
  383.             ; GROB to PICT.
  384.  
  385.     MOVE.A    R2, C    ; Get the pointer to the GROB data.
  386.     ADD.A    A, C    ; Add the offset (R)
  387.     MOVE.A    C, D1    ; Point to nibble in stack GROB to be read.
  388.     CLR.W    A    ; Zero out A.
  389.     MOVE.B    @D1, A    ; Get the nibble from the GROB into A.
  390.  
  391. ; Now what I need to do is GROB*MASK+PICT*MASK_BAR  ---> PICT.
  392.  
  393.     AND.B    B, A    ; Perform bit-AND of BITMASK and nibble from GROB.
  394.             ; This value will be ORd with the same nibble from
  395.             ; PICT and written back into PICT, thus moving the bit
  396.             ; from the stack GROB to PICT.
  397.  
  398.     MOVE.W    R3, C    ; Get the pointer into the GROB.
  399.  
  400. ; At this point, the modified nibble from stack GROB is in A.  
  401. ;         the offset into PICT is in C.
  402.  
  403.     SWAP.A    A, D1    ; Save the nibble in A into D1 for a moment.
  404.     MOVE.A    R0, A    ; Get the address of PICT.
  405.     ADD.A    A, C    ; Now C contains the address of the nibble in PICT.
  406.     SWAP.A    A, D1    ; Restore the nibble from the source GROB into A.
  407.     MOVE.A    C, D1    ; Point into PICT.
  408.     MOVE.B    @D1, C    ; Get the nibble from PICT.
  409.     NOT.B    B    ; Invert the mask for a moment.
  410.     AND.B    B, C    ; Mask off the bits to be modified.
  411.     OR.B    A, C    ; Modify the BITMASKth bit in the nibble,....
  412.     NOT.B    B    ; restore the mask to its original state.
  413.     MOVE.1    C, @D1    ; and write it back into PICT.
  414.     RET
  415.  
  416.     endcode
  417.  
  418.     radix ^x10    ; Go back to hex.
  419.      RPL
  420.     312b        ; end marker.
  421.     312b        ; End program object
  422.     ENDRPL
  423.  
  424. end
  425.  
  426.